home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / pascal / totsrc.zip / EXTWIN.PAS < prev    next >
Pascal/Delphi Source File  |  1991-02-11  |  8KB  |  303 lines
  1. Unit ExtWin;
  2. {Illustrates how you can extend the Toolkit StretchWinOBJ to provide
  3.  a window for displaying virtual screens}
  4.  
  5. {$I TOTFLAGS.INC}
  6. INTERFACE
  7.  
  8. uses DOS, CRT, totFAST, totWIN, totINPUT;
  9.  
  10. TYPE
  11. VirtualWinOBJ = object (StretchWinOBJ)
  12.    vScreen: ScreenPtr;
  13.    vTopLine: integer;
  14.    vFirstChar: integer;
  15.    vScreenWidth: byte;
  16.    vScreenDepth: byte;
  17.    {Methods...}
  18.    constructor Init;
  19.    procedure   SetScreenXY(X,Y:byte);
  20.    procedure   AssignVirtualScreen(var Scr:ScreenOBJ);
  21.    procedure   RefreshWindow;
  22.    procedure   ScrollDown;
  23.    procedure   ScrollUp;
  24.    procedure   ScrollLeft;
  25.    procedure   ScrollRight;
  26.    procedure   ScrollTop;
  27.    procedure   ScrollBottom;
  28.    procedure   ScrollHome;
  29.    procedure   ScrollEnd;
  30.    procedure   ScrollJump(Vert:boolean; X,Y:byte);
  31.    procedure   ScrollPgUp;
  32.    procedure   ScrollPgDn;
  33.    procedure   Go;
  34.    procedure   StretchRefresh;                                 VIRTUAL;
  35.    procedure   Winkey(var K:word;var X,Y:byte);                VIRTUAL;
  36.    procedure   Draw;                                           VIRTUAL;
  37.    destructor  Done;                                           VIRTUAL;
  38. end; {VirtualWinOBJ}
  39.  
  40. IMPLEMENTATION
  41.  
  42. constructor VirtualWinOBJ.Init;
  43. {Initializes the window, and sets the ScreanOBJ pointer to nil}
  44. begin
  45.    StretchWinOBJ.Init;
  46.    SetScrollable(true,true);
  47.    vScreen := nil;
  48.    vSmartStretch := true;
  49. end; {VirtualWinOBJ.Init}
  50.  
  51. procedure VirtualWinOBJ.SetScreenXY(X,Y:byte);
  52. {Sets the upper-left coordinates of the visible part of virtual screen}
  53. begin
  54.    if X <= vScreenWidth then
  55.       vFirstChar := X;
  56.    if Y <= vScreenDepth then
  57.       vTopLine := Y;
  58. end; {VirtualWinOBJ.SetScreenXY}
  59.  
  60. procedure VirtualWinOBJ.RefreshWindow;
  61. {Grabs the info from the virtual display and shows it in window}
  62. var  WinOff: boolean;
  63. begin
  64.    WinOff := Screen.Windowoff;
  65.    StretchRefresh; 
  66.    if not WinOff then
  67.       Screen.WindowOn;
  68.    {now update the scroll bar elevators}
  69.    DrawHorizBar(vFirstChar,vScreenWidth);
  70.    DrawVertBar(vTopLine,vScreenDepth);
  71. end; {VirtualWinOBJ.RefreshWindow}
  72.  
  73. procedure VirtualWinOBJ.StretchRefresh;
  74. {This procedure is called by RefreshWindow, as well as
  75.  StretchWinOBJ.Stretch. In both cases, the Window 
  76.  settings are turned off}
  77. var 
  78.   W,D,Z:byte;
  79.   I:integer;
  80.   Pad: string;
  81. begin
  82.     with vBorder do
  83.     begin
  84.        W := pred(X2-X1);
  85.        D := pred(Y2-Y1);
  86.        vScreen^.PartDisplay(vFirstChar,vTopLine,
  87.                             vFirstChar+pred(W),vTopLine+pred(D),
  88.                             succ(X1),succ(Y1));
  89.        if succ(vScreenWidth-vFirstChar) < W then
  90.        begin
  91.           Pad := replicate(W - pred(vScreenWidth-vFirstChar)-1,' ');
  92.           Z :=  succ(X1) + vScreenWidth-vFirstChar;
  93.           for I := succ(Y1) to pred(Y2) do
  94.               Screen.WriteAt(Z,I,vBodyAttr,Pad);
  95.        end;
  96.        if succ(vScreenDepth-vTopLine) < D then
  97.        begin
  98.           Pad := replicate(pred(X2-X1),' ');
  99.           Z :=  Y1 + vScreenDepth-vTopLine+2;
  100.           for I := Z to pred(Y2) do
  101.               Screen.WriteAt(succ(X1),I,vBodyAttr,Pad);
  102.        end;
  103.     end;
  104. end; {VirtualWinOBJ.StretchRefresh}
  105.  
  106. procedure VirtualWinOBJ.AssignVirtualScreen(var Scr:ScreenOBJ);
  107. {Updates vScreen to point to the user specified ScreenOBJ instance, 
  108.  and sets the intital display position to topleft.}
  109. begin
  110.    vScreen := @Scr;
  111.    vTopLine := 1;
  112.    vFirstChar := 1;
  113.    vScreenWidth := vScreen^.Width;
  114.    vScreenDepth := vScreen^.Depth;
  115. end; {VirtualWinOBJ.AssignVirtualScreen}
  116.  
  117. procedure VirtualWinOBJ.ScrollDown;
  118. {}
  119. begin
  120.    if vTopLine < vScreenDepth then
  121.    begin
  122.       inc(vTopLine);
  123.       RefreshWindow;
  124.    end;
  125. end; {VirtualWinOBJ.ScrollDown}
  126.  
  127. procedure VirtualWinOBJ.ScrollUp;
  128. {}
  129. begin
  130.    if vTopLine > 1 then
  131.    begin
  132.       dec(vTopLine);
  133.       RefreshWindow;
  134.    end;
  135. end; {VirtualWinOBJ.ScrollUp}
  136.  
  137. procedure VirtualWinOBJ.ScrollLeft;
  138. {}
  139. begin
  140.    if vFirstChar > 1 then
  141.    begin
  142.       dec(vFirstChar);
  143.       RefreshWindow;
  144.    end;
  145. end; {VirtualWinOBJ.ScrollLeft}
  146.  
  147. procedure VirtualWinOBJ.ScrollRight;
  148. {}
  149. begin
  150.    if vFirstChar  < vScreenWidth then
  151.    begin
  152.       inc(vFirstChar);
  153.       RefreshWindow;
  154.    end;
  155. end; {VirtualWinOBJ.ScrollRight}
  156.  
  157. procedure VirtualWinOBJ.ScrollTop;
  158. {}
  159. begin
  160.    if vTopLine <> 1 then
  161.    begin
  162.       vTopLine := 1;
  163.       RefreshWindow;
  164.    end;
  165. end; {VirtualWinOBJ.ScrollTop}
  166.  
  167. procedure VirtualWinOBJ.ScrollBottom;
  168. {}
  169. begin
  170.    if vTopLine + vBorder.Y2 - vBorder.Y1 - 2 < vScreenDepth then
  171.    begin
  172.       vTopLine := vScreenDepth - (vBorder.Y2 - vBorder.Y1 - 2);
  173.       RefreshWindow;
  174.    end;
  175. end; {VirtualWinOBJ.ScrollBottom}
  176.  
  177. procedure VirtualWinOBJ.ScrollHome;
  178. {}
  179. begin
  180.    if vFirstChar > 1 then
  181.    begin
  182.       vFirstChar := 1;
  183.       RefreshWindow;
  184.    end;
  185. end; {VirtualWinOBJ.ScrollHome}
  186.  
  187. procedure VirtualWinOBJ.ScrollEnd;
  188. {}
  189. begin
  190.    if vFirstChar + vBorder.X2 - vBorder.X1 - 2 < vScreenWidth then
  191.    begin
  192.       vFirstChar := vScreenWidth - (vBorder.X2 - vBorder.X1 - 2);
  193.       RefreshWindow;
  194.    end;
  195. end; {VirtualWinOBJ.ScrollEnd;}
  196.  
  197. procedure VirtualWinOBJ.ScrollJump(Vert:boolean; X,Y:byte);
  198. {}
  199. var I:integer;
  200. begin
  201.    if Vert then
  202.    begin
  203.       if X = 1 then
  204.          ScrollTop
  205.       else   
  206.       begin
  207.          I := (X * vScreenDepth);
  208.          vTopLine :=  I div Y;
  209.          RefreshWindow;
  210.       end;
  211.    end
  212.    else
  213.    begin
  214.       if X = 1 then
  215.          ScrollHome
  216.       else   
  217.       begin
  218.          I := (X * vScreenWidth);
  219.          vFirstChar :=  I div Y;
  220.          RefreshWindow;
  221.       end;
  222.    end;   
  223. end; {VirtualWinOBJ.Scroll}
  224.  
  225. procedure VirtualWinOBJ.ScrollPgUp;
  226. {}
  227. begin
  228.    if vTopLine > 1 then
  229.    begin
  230.       vTopLine := vTopLine - pred(vBorder.Y2-vBorder.Y1);
  231.       if vTopLine < 1 then
  232.          vTopLine := 1;
  233.       RefreshWindow;
  234.    end;
  235. end; {VirtualWinOBJ.ScrollPgUp}
  236.  
  237. procedure VirtualWinOBJ.ScrollPgDn;
  238. {}
  239. begin
  240.    if vTopLine < vScreenDepth then
  241.    begin
  242.       vTopLine := vTopLine + pred(vBorder.Y2-vBorder.Y1);
  243.       if vTopLine > vScreenDepth then
  244.          vTopLine := vScreenDepth;
  245.       RefreshWindow;
  246.    end;
  247. end; {VirtualWinOBJ.ScrollPgDn}
  248.  
  249. procedure VirtualWinOBJ.Winkey(var K:word;var X,Y:byte);
  250. {process keystroke and updates window}
  251. begin
  252.    StretchWinOBJ.WinKey(K,X,Y);   {pass key to StretcWinOBJ for stretch and move}
  253.    case K of
  254.       602:RefreshWindow;          {resized}
  255.       328,610: ScrollUp;          {scroll up}
  256.       336,611: ScrollDown;        {scroll down}
  257.       331,612: ScrollLeft;        {scroll left}
  258.       333,613: ScrollRight;       {scroll right}
  259.       614: ScrollJump(true,X,Y);  {vertical jump}
  260.       615: ScrollJump(false,X,Y); {horizontal jump}
  261.       388: ScrollTop;             {Ctrl-PgUp}
  262.       374: ScrollBottom;          {Ctrl-PgDn}
  263.       335: ScrollEnd;             {End}
  264.       327: ScrollHome;            {Home}
  265.       329: ScrollPgUp;            {PgUp}
  266.       337: ScrollPgDn;            {PgDn}
  267.    end; {case}
  268. end; {VirtualWinOBJ.Winkey}
  269.  
  270. procedure VirtualWinOBJ.Draw;
  271. {Draws the window and the contents.}
  272. begin
  273.    if vUnderneathPtr = nil then
  274.       StretchWinOBJ.Draw;
  275.    RefreshWindow;
  276. end; {VirtualWinOBJ.Draw}
  277.  
  278. procedure VirtualWinOBJ.Go;
  279. {Keeps getting user input until users escapes or closes window.}
  280. var
  281.    K: word;
  282.    X,Y: byte;
  283. begin
  284.    Draw;
  285.    Screen.CursOff;
  286.    repeat
  287.       with Key do
  288.       begin
  289.          K := GetKey;
  290.          X := LastX;
  291.          Y := LastY;
  292.       end;
  293.       WinKey(K,X,Y);
  294.    until (K = 27) or (K = 600);
  295. end; {VirtualWinOBJ.Go}
  296.  
  297. destructor VirtualWinOBJ.Done;
  298. {}
  299. begin
  300.    StretchWinOBJ.Done
  301. end; {VirtualWinOBJ.Done}
  302.  
  303. end.